home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADFILES.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-01-23  |  2.3 KB  |  47 lines

  1. 10  DIM U$(16):ON KEY(10) GOSUB 190:KEY(10) ON:ON ERROR GOTO 2000:GOTO 20
  2. 15  Y1=VAL(Y1$):ON KEY(10) GOSUB 190:KEY(10) ON:ON ERROR GOTO 2000
  3. 20  GOSUB 170:LOCATE 22,45:PRINT "KEY F10 to exit & ":COLOR 14,0:LOCATE 22,49:PRINT "F10":LOCATE 22,63:PRINT ARR$:COLOR 3,0
  4. 25  DEF SEG =&H40:POKE &H17,&H40
  5. 30  ZK(1)=1:ERASE ZK:CLOSE:DIM ZK(40):OPEN FILM$ FOR INPUT AS #3
  6. 35  INPUT #3,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:FOR I= 1 TO 36:INPUT #3, ZK(I):NEXT :CLOSE #3
  7. 37  LOCATE 10,29:PRINT "Enter complete FILESPEC":LOCATE 12,29:PRINT "[EXAMPLE:  B:ZIP-FIL]":LOCATE 14,30:PRINT "Default drive is ";F$:LOCATE 16,32:COLOR 14,0:GOSUB 180:PRINT "FILENAME ... ";
  8. 38  LOCATE 16,46:INPUT "",FILET$
  9. 40  DEF SEG =&H40:POKE &H17,&H40
  10. 41  IF FILET$="" THEN GOSUB 35020:GOTO 40
  11. 42  Z=INSTR(1,FILET$,":"):IF Z=0 THEN FILET$=F$+FILET$
  12. 45  Z =INSTR(1,FILET$,"."):IF Z=0 THEN 46 ELSE FILET$=LEFT$(FILET$,Z-1)
  13. 46  FILT$=FILET$:FILM2$=FILET$+".ISS":FILET$=FILET$+".DAT"
  14. 50  OPEN FILM2$ FOR INPUT AS #2
  15. 51  COLOR 11,0:LOCATE 18,25:PRINT "Confirm Overwrite of ";:COLOR 12,0:PRINT FILET$:COLOR 3,0:LOCATE 20,35:PRINT "<Y> or <N>":COLOR 14,0:LOCATE 20,36:PRINT "Y":LOCATE 20,43:PRINT "N":COLOR 3,0
  16. 52  GOSUB 35020
  17. 53  Y$=INKEY$:IF Y$="" THEN 53 ELSE Y$=CHR$(ASC(Y$) AND &HDF)
  18. 54  IF Y$="Y" THEN 57
  19. 55  IF Y$="N" THEN 190 ELSE 52
  20. 57  GOSUB 170:COLOR 11,0:LOCATE 12,27:PRINT "Saving data in ";:COLOR 12,0:PRINT FILET$
  21. 58  LOCATE 20,35:COLOR 16,7:PRINT " WORKING ":COLOR 3,0
  22. 60  CLOSE #2:OPEN FILM2$ FOR OUTPUT AS #1
  23. 65  WRITE #1,Y$,NRED,NN,FILET$,FILT$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:FOR I= 1 TO 36:WRITE #1, ZK(I):NEXT :CLOSE #1
  24. 70  OPEN FILET$ AS #1 LEN = 356
  25. 75  DEF SEG =&H40:POKE &H17,&H0
  26. 80  OPEN FILE$ AS #4 LEN = 356
  27. 85  FIELD #4, 19 AS V$(1), 19 AS V$(2), 18 AS V$(13), 34 AS V$(12), 34 AS V$(3), 34 AS V$(4), 19 AS V$(5), 14 AS V$(6), 16 AS V$(7), 12 AS V$(8), 84 AS V$(9), 19 AS V$(10), 19 AS V$(11), 5 AS V$(14), 5 AS V$(15), 5 AS V$(16)
  28. 90  FIELD #1, 19 AS U$(1), 19 AS U$(2), 18 AS U$(13), 34 AS U$(12), 34 AS U$(3), 34 AS U$(4), 19 AS U$(5), 14 AS U$(6), 16 AS U$(7), 12 AS U$(8), 84 AS U$(9), 19 AS U$(10), 19 AS U$(11), 5 AS U$(14), 5 AS U$(15), 5 AS U$(16)
  29. 100  FOR I=1 TO NN+1:GET #4,I:FOR J= 1 TO 16 :LSET U$(J)=V$(J):NEXT:PUT #1,I:NEXT
  30. 110  ERASE U$:CLOSE #1:COLOR 3,0
  31. 165  GOTO 190
  32. 170  CLS:X4$=SPACE$(15):LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;" WRITING ";:COLOR 3,0:LOCATE 1,1:RETURN
  33. 180  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 4:SOUND 500*SS%,2:NEXT:RETURN
  34. 190  ON Y1 GOTO 240,200,250,210,220,230,260
  35. 200  RUN "ADEDIT.BAS"
  36. 210  RUN "ADSORT.BAS"
  37. 220  RUN "ADSEARCH.BAS"
  38. 230  RUN "ADPRINT.BAS"
  39. 240  RUN "ADMAIN.BAS"
  40. 250  RUN "ADDELETE.BAS"
  41. 260  RUN "ADMAIN.BAS"
  42. 2000  IF ERR = 61 THEN LOCATE 10,1:PRINT "DISK FULL.  LOAD FORMATTED DISK AND TYPE <CONT> AND RETURN ":COLOR 14,0:LOCATE 10,43:PRINT "CONT":BEEP:COLOR 3,0:STOP
  43. 2020  IF ERR = 61 THEN RESUME 190
  44. 2025  IF ERL =50 THEN RESUME 57
  45. 2030  RESUME 190
  46. 35020  IF SND$="N" THEN RETURN ELSE BEEP:RETURN
  47.